home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / s / substitutefont.pprx < prev    next >
Text File  |  1993-01-28  |  2KB  |  94 lines
  1. /*
  2. @BSubStituteFont  @P@ICopyright Gold Disk Inc., Jan, 1993
  3.  
  4. This Genie will substitute one font for another throughout an entire document.
  5. */
  6. arg font, replacement
  7. address command
  8. call SafeEndEdit.rexx()
  9. call ppm_AutoUpdate(0)
  10. cpage   = ppm_CurrentPage()
  11.  
  12. if font = '' then
  13. do
  14.     font = ppm_SelectFromList("Enter font to change", 32, 8, 0, FontList.rexx(ppm_GetFont()))
  15.  
  16.     if font = '' then exit_msg()
  17.  
  18.     replacement = ppm_SelectFromList("Enter font to change", 32, 8, 0, FontList.rexx(ppm_GetFont()))
  19.  
  20. end
  21.  
  22. if replacement = '' then exit_msg()
  23.  
  24. font = "ff<"font">"
  25. flen = length(font)
  26. upperfont   = upper(font)
  27. replacement = "ff<"replacement">"
  28. rlen        = length(replacement)
  29.  
  30. call ppm_ShowStatus("Working..")
  31. randval = (randu() * time(s)) % 1
  32. box = ppm_DocFirstBox()
  33.  
  34. do while box ~= 0
  35.  
  36.     info    = upper(word(ppm_GetBoxInfo(box), 1))
  37.  
  38.     if (info = "TEXT") & (ppm_GetBoxUserData(box) ~= randval) then
  39.     do
  40.                 oldbox = box
  41.                 box = ppm_ArtFirstBox(box)
  42.         boxtext = ppm_GetArticleText(box, 1)
  43.  
  44.         fpos = 1
  45.         change = 0
  46.  
  47.         do forever
  48.  
  49.                 uppertext   = upper(boxtext)
  50.  
  51.             fpos = pos(upperfont, uppertext, fpos)
  52.             if fpos = 0 then leave
  53.  
  54.             change = 1
  55.  
  56.             boxtext = delstr(boxtext, fpos, flen)
  57.             boxtext = insert(replacement, boxtext, fpos - 1,  rlen)
  58.             fpos = fpos + rlen
  59.  
  60.         end
  61.  
  62.         if change then
  63.         do
  64.                         call ppm_DeleteContents(box)
  65.                         call ppm_TextIntoBox(box, boxtext)
  66.         end
  67.  
  68.                 do while box ~= 0
  69.  
  70.                         call ppm_SetBoxUserData(box, randval)
  71.                         box = ppm_ArtNextBox(box)
  72.  
  73.                 end
  74.                 box = oldbox
  75.     end
  76.  
  77.     box = ppm_DocNextBox(box)
  78.  
  79. end
  80.  
  81. exit_msg("Done")
  82.  
  83. exit_msg: procedure expose cpage
  84. do
  85.     parse arg message
  86.  
  87.     if message ~= '' then call ppm_Inform(1,message,)
  88.     if cpage ~= 0 then call ppm_GotoPage(cpage)
  89.     call ppm_ClearStatus()
  90.     call ppm_AutoUpdate(1)
  91.     exit
  92. end
  93.  
  94.